BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Hyper/S-Sh/SearchreplaceXCMD1.5.1.cpt/SearchReplace XCMD v.1.5.1/card_6095.txt

Text File | 1989-07-02 | 10KB | 416 lines

-- card: 6095 from stack: in.1
-- bmap block id: 6336
-- flags: 0000
-- background id: 2639
-- name:


-- part 1 (field)
-- low flags: 01
-- high flags: 0007
-- rect: left=34 top=126 right=314 bottom=473
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 9
-- style flags: 0
-- line height: 12
-- part name: source code listing


-- part 2 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=34 top=313 right=333 bottom=154
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Copy Source Code


-- part contents for background part 7
----- text -----
For those of you interested, here is the source code listing for the SearchReplace XCMD done in Think Pascal‚Ñ¢. It was compiled and linked with the DRVRRuntime library. Then it was built and saved as a resource of type XCMD and pasted via ResEdit into this stack. The modeless dialog was built in ResEdit.


-- part contents for card part 1
----- text -----
unit SearchandReplaceXCMD;
interface
 type
  XCmdPtr = ^XCmdBlock;
  XCmdBlock = record
    paramCount: INTEGER;
    params: array[1..16] of Handle;
    returnValue: Handle;
    passFlag: BOOLEAN;

    entryPoint: ProcPtr;
    request: INTEGER;
    result: INTEGER;
    inArgs: array[1..8] of LongInt;
    outArgs: array[1..4] of LongInt;
   end;

 procedure main (paramPtr: XCmdPtr);

implementation
 procedure SearchReplace (paramPtr: XCmdPtr);
 forward;

 procedure main;
 begin
  SearchReplace(paramPtr);
 end;

 procedure SearchReplace;
  const
   xreqSendCardMessage = 1;
   xreqEvalExpr = 2;
   xreqZeroToPas = 8;
   off = 0;
   on = 1;
   dimBtn = 255;
   noDimBtn = 0;
   SValue = 0;
   SHilite = 1;
   SFrame = 2;
   EditSearchitem = 3;
   EditReplaceItem = 4;
   FindStringItem = 5;
   FindWholeItem = 6;
   FindNextBtnItem = 7;
   ReplaceBtnItem = 8;
   ReplaceAllBtnItem = 9;
   theDlg = 14987;
  var
   thePart: integer;
   searchString, replaceString, theMessage, theString: str255;
   done, EventOccurred, searchType, BtnUpdate: boolean;
   thePoint: point;
   textCursor: curshandle;
   oldPort: grafptr;
   whichWindow: WindowPtr;
   myEvent: EventRecord;
   SearchReplaceDlg: dialogPtr;

  procedure DoJsr (addr: ProcPtr);
  inline
   $205F, $4E90;

  procedure ZeroToPas (zeroStr: Ptr; var pasStr: Str255);
  begin
   with paramPtr^ do
    begin
     inArgs[1] := ORD(zeroStr);
     inArgs[2] := ORD(@pasStr);
     request := xreqZeroToPas;
     DoJsr(entryPoint);
    end;
  end;

  function EvalExpr (expr: Str255): Handle;
  begin
   with paramPtr^ do
    begin
     inArgs[1] := ORD(@expr);
     request := xreqEvalExpr;
     DoJsr(entryPoint);
     EvalExpr := Handle(outArgs[1]);
    end;
  end;

  procedure SendCardMessage (msg: Str255);
  begin
   with paramPtr^ do
    begin
     inArgs[1] := ORD(@msg);
     request := xreqSendCardMessage;
     DoJsr(entryPoint);
    end;
  end;

  procedure AdjustThisItem (theItem: integer; btnFunction, state: integer);
   var
    itemtype: integer;
    itemhandle: handle;
    dispRect: rect;
    crtlhandle: controlHandle;
   procedure DoBtnFrame;
    var
     oldPenState: PenState;
   begin
    GetPenState(oldPenState);
    InsetRect(dispRect, -4, -4);
    PenSize(3, 3);
    FrameRoundRect(dispRect, 16, 16);
    SetPenState(oldPenState);
   end;
  begin
   GetDItem(SearchReplaceDlg, theItem, itemType, itemHandle, dispRect);
   crtlHandle := controlhandle(itemhandle);
   case btnFunction of
    SHilite:
     HiliteControl(crtlhandle, state);
    SValue:
     SetCtlValue(crtlhandle, state);
    SFrame:
     DoBtnFrame;
   end;
  end;

  procedure FBtnUpdate;
  begin
   if theString = '' then
    begin
     AdjustThisItem(FindNextBtnItem, SHilite, dimBtn);
     AdjustThisItem(ReplaceBtnItem, SHilite, dimBtn);
     AdjustThisItem(ReplaceAllBtnItem, SHilite, dimBtn);
    end
   else
    AdjustThisItem(ReplaceBtnItem, SHilite, nodimBtn);
  end;

  procedure DoFind;
   var
    searchMethod, quotedFindString: str255;
    theHandle: handle;
  begin
   if searchType then
    searchMethod := 'string '
   else
    searchMethod := 'whole ';
   quotedFindString := concat('"', searchString, '"');
   theMessage := concat('find ', searchMethod, quotedFindString);
   SendCardMessage(theMessage);
   theHandle := EvalExpr('the foundChunk');
   ZeroToPas(theHandle^, theString);
   setPort(SearchReplaceDlg);
   if BtnUpdate then
    FBtnUpdate;
  end;

  procedure DoReplace;
   var
    quotedReplaceString: str255;
   procedure RBtnUpdate;
   begin
    AdjustThisItem(ReplaceBtnItem, SHilite, dimBtn);
   end;
  begin
   if theString <> '' then
    begin
     SendCardMessage('put the foundchunk into markedText');
     quotedReplaceString := concat('"', replaceString, '"');
     theMessage := concat(' put "put "  & quote &', quotedReplaceString, '& quote & " into "  & markedText into replaceAction ');
     SendCardMessage(theMessage);
     SendCardMessage('send replaceAction');
     setPort(SearchReplaceDlg);
     if BtnUpdate then
     RBtnUpdate;
    end;
  end;

  procedure DoReplaceAll;
  begin
   BtnUpdate := false;
   repeat
    begin
     DoFind;
     DoReplace;
    end;
   until theString = '';
   FBtnUpdate;
   BtnUpdate := true;
  end;

  procedure DotheDialog (myEvent: EventRecord);
   var
    DialogHit: boolean;
    whichDialog: DialogPtr;
    theItem, itemType: integer;
    dispRect: rect;
    itemhandle: handle;
   procedure KeyDownEvent;
    const
     ReturnKey = 13;
     EnterKey = 3;
    var
     chCode: integer;
    procedure FlushPendingEvent;
    begin
     FlushEvents(everyEvent, 0);
     EventOccurred := GetNextEvent(everyEvent, myEvent);
    end;
   begin
    with myEvent do
     begin
     chCode := BitAnd(message, CharCodeMask);
     if (chCode = ReturnKey) or (chCode = EnterKey) then
     begin
     if what = autokey then
     while what = autoKey do
     begin
     DoFind;
     EventOccurred := GetNextEvent(everyEvent, myEvent);
     end
     else
     DoFind;
     FlushPendingEvent;
     end;
     end;
   end;
   procedure CheckTheItems;
   begin
    case theItem of
     EditSearchitem:
     begin
     GetDItem(whichDialog, EditSearchitem, itemtype, itemhandle, dispRect);
     GetIText(itemhandle, searchString);
     if searchString <> '' then
     begin
     AdjustThisItem(FindNextBtnItem, SHilite, nodimBtn);
     AdjustThisItem(ReplaceBtnItem, SHilite, nodimBtn);
     AdjustThisItem(ReplaceAllBtnItem, SHilite, nodimBtn);
     end
     else
     begin
     AdjustThisItem(FindNextBtnItem, SHilite, dimBtn);
     AdjustThisItem(ReplaceBtnItem, SHilite, dimBtn);
     AdjustThisItem(ReplaceAllBtnItem, SHilite, dimBtn);
     end;
     end;
     EditReplaceItem:
     begin
     GetDItem(SearchReplaceDlg, EditReplaceItem, itemtype, itemhandle, dispRect);
     GetIText(itemhandle, replaceString);
     end;
     FindStringItem:
     begin
     searchType := true;
     AdjustThisItem(FindStringItem, SValue, on);
     AdjustThisItem(FindWholeItem, SValue, off);
     end;
     FindWholeItem:
     begin
     searchType := false;
     AdjustThisItem(FindStringItem, SValue, off);
     AdjustThisItem(FindWholeItem, SValue, on);
     end;
     FindNextBtnItem:
     DoFind;
     ReplaceBtnItem:
     DoReplace;
     ReplaceAllBtnItem:
     DoReplaceAll;
     otherwise
    end;
   end;
  begin
   if (myEvent.what = keyDown) or (myEvent.what = autoKey) then
    KeyDownEvent;
   if DialogSelect(myEvent, whichDialog, theItem) then
    CheckTheItems
   else if myEvent.what = UpdateEvt then
    AdjustThisItem(FindNextBtnItem, SFrame, on);
  end;

  procedure SetUpDialog;
   var
    itemtype: integer;
    itemhandle: handle;
    dispRect: rect;
   procedure InitialBtnSettings;
   begin
    done := false;
    textCursor := GetCursor(IBeamCursor);
    searchType := true;
    BtnUpdate := true;
    theString := '';
    replaceString := '';
    AdjustThisItem(FindStringItem, SValue, on);
    AdjustThisItem(FindWholeItem, SValue, off);
    AdjustThisItem(FindNextBtnItem, SHilite, dimBtn);
    AdjustThisItem(ReplaceBtnItem, SHilite, dimBtn);
    AdjustThisItem(ReplaceAllBtnItem, SHilite, dimBtn);
   end;
  begin
   getPort(oldPort);
   SearchReplaceDlg := GetNewDialog(theDlg, nil, pointer(-1));
   ShowWindow(SearchReplaceDlg);
   setPort(SearchReplaceDlg);
   InitialBtnSettings;
   DrawDialog(SearchReplaceDlg);
  end;

  procedure MouseDownEvent;
   var
    dragBnds: rect;
  begin
   thePart := FindWindow(myEvent.where, whichWindow);
   case thePart of
    inGoAway:
     if whichWindow = SearchReplaceDlg then
     done := TrackGoAway(whichWindow, myEvent.where);
    inDrag:
     begin
     if whichWindow = SearchReplaceDlg then
     begin
     setRect(dragBnds, 4, 24, 508, 338);
     DragWindow(whichWindow, myEvent.where, dragBnds);
     SendCardMessage('go this card ');
     end;
     end;
    otherwise
   end;
  end;

  procedure AdjustCursor;
   var
    searchRect, replaceRect: rect;
    itemType: integer;
    itemHandle: handle;
  begin
   setPort(SearchReplaceDlg);
   GetMouse(thePoint);
   GetDItem(SearchReplaceDlg, EditSearchitem, itemtype, itemhandle, searchRect);
   GetDItem(SearchReplaceDlg, EditReplaceItem, itemtype, itemhandle, replaceRect);
   if PtInRect(thePoint, searchRect) or PtInRect(thePoint, replaceRect) then
    setCursor(textCursor^^)
   else
    InitCursor;
  end;

  procedure Goodbye;
  begin
   setPort(oldPort);
   DisposDialog(SearchReplaceDlg);
   FlushEvents(everyEvent, 0);
  end;

 begin
  SetUpDialog;
  repeat
   begin
    AdjustCursor;
    SystemTask;
    EventOccurred := GetNextEvent(everyEvent, myEvent);
    if IsDialogEvent(myEvent) then
     DoTheDialog(myEvent)
    else if EventOccurred then
     case myEvent.what of
     mouseDown:
     MouseDownEvent;
     otherwise
     end;
   end;
  until done;
  Goodbye;
 end;
end.